home *** CD-ROM | disk | FTP | other *** search
/ Personal Computer World 2009 February / PCWFEB09.iso / Software / Linux / Kubuntu 8.10 / kubuntu-8.10-desktop-i386.iso / casper / filesystem.squashfs / usr / bin / fileshareset < prev    next >
Text File  |  2008-10-06  |  11KB  |  431 lines
  1. #!/usr/bin/perl -T
  2. use strict;
  3.  
  4. ########################################
  5. # config files
  6. $nfs_exports::default_options = '*(ro,all_squash)';
  7. $nfs_exports::conf_file = '/etc/exports';
  8. $smb_exports::conf_file = '/etc/samba/smb.conf';
  9. my $authorisation_file = '/etc/security/fileshare.conf';
  10. my $authorisation_group = 'fileshare';
  11.  
  12.  
  13. ########################################
  14. # Copyright (C) 2001-2002 MandrakeSoft (pixel@mandrakesoft.com)
  15. #
  16. # This program is free software; you can redistribute it and/or modify
  17. # it under the terms of the GNU General Public License as published by
  18. # the Free Software Foundation; either version 2, or (at your option)
  19. # any later version.
  20. #
  21. # This program is distributed in the hope that it will be useful,
  22. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  23. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  24. # GNU General Public License for more details.
  25. #
  26. # You should have received a copy of the GNU General Public License
  27. # along with this program; if not, write to the Free Software
  28. # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
  29.  
  30.  
  31. ########################################
  32. my $uid = $<;
  33. my $username = getpwuid($uid);
  34.  
  35. ########################################
  36. # errors
  37. my $usage =
  38. "usage: fileshareset --add <dir>
  39.        fileshareset --remove <dir>";
  40. my $not_enabled =
  41. qq(File sharing is not enabled.
  42. To enable file sharing put 
  43. "FILESHARING=yes" in $authorisation_file);
  44.        
  45. my $not_simple_enabled = 
  46. qq(Simple file sharing is not enabled.
  47. To enable simple file sharing put
  48. "SHARINGMODE=simple" in $authorisation_file);
  49.  
  50. my $non_authorised =
  51. qq(You are not authorised to use file sharing
  52. To grant you the rights:
  53. - put "RESTRICT=no" in $authorisation_file
  54. - or put user "$username" in group "$authorisation_group");
  55.  
  56. my $no_export_method = "can't export anything: no nfs, no smb";
  57.  
  58. my %exit_codes = reverse (
  59.   1 => $non_authorised,
  60.   2 => $usage,
  61.  
  62. # when adding
  63.   3 => "already exported", 
  64.   4 => "invalid mount point",
  65.  
  66. # when removing
  67.   5 => "not exported",
  68.  
  69.   6 => $no_export_method,
  70.   
  71.   7 => $not_enabled,
  72.   
  73.   8 => $not_simple_enabled,
  74.  
  75.   255 => "various",
  76. );
  77.  
  78. ################################################################################
  79. # correct PATH needed to call /etc/init.d/... ? seems not, but...
  80. %ENV = ();#(PATH => '/bin:/sbin:/usr/bin:/usr/sbin');
  81.  
  82. my $modify = $0 =~ /fileshareset/;
  83.  
  84. authorisation::check($modify);
  85.  
  86. my @exports = (
  87.            -e $nfs_exports::conf_file ? nfs_exports::read() : (),
  88.            -e $smb_exports::conf_file ? smb_exports::read() : (),
  89.           );
  90. @exports or error($no_export_method);
  91.  
  92. if ($modify) {
  93.     my ($cmd, $dir) = @ARGV;
  94.     $< = $>;
  95.     @ARGV == 2 && ($cmd eq '--add' || $cmd eq '--remove') or error($usage);
  96.  
  97.     verify_mntpoint($dir);
  98.  
  99.     if ($cmd eq '--add') {
  100.     my @errs = map { eval { $_->add($dir) }; $@ } @exports;
  101.     grep { !$_ } @errs or error("already exported");
  102.     } else {
  103.     my @errs = map { eval { $_->remove($dir) }; $@ } @exports;
  104.     grep { !$_ } @errs or error("not exported");
  105.     }    
  106.     foreach my $export (@exports) {
  107.     $export->write;
  108.     $export->update_server;
  109.     }
  110. }
  111. my @mntpoints = grep {$_} uniq(map { map { $_->{mntpoint} } @$_ } @exports);
  112. print "$_\n" foreach grep { own($_) } @mntpoints;
  113.  
  114.  
  115. sub own { $uid == 0 || (stat($_[0]))[4] == $uid }
  116.  
  117. sub verify_mntpoint {
  118.     local ($_) = @_;
  119.     my $ok = 1;
  120.     $ok &&= m|^/|;
  121.     $ok &&= !m|/\.\./|;
  122.     $ok &&= !m|[\0\n\r]|;
  123.     $ok &&= -d $_;
  124.     $ok &&= own($_);
  125.     $ok or error("invalid mount point");
  126. }
  127.  
  128. sub error {
  129.     my ($string) = @_;
  130.     print STDERR "$string\n";
  131.     exit($exit_codes{$string} || 255);
  132. }
  133. sub member { my $e = shift; foreach (@_) { $e eq $_ and return 1 } 0 }
  134. sub uniq { my %l; $l{$_} = 1 foreach @_; grep { delete $l{$_} } @_ }
  135.  
  136.  
  137. ################################################################################
  138. package authorisation;
  139.  
  140. sub read_conf {
  141.     my ($exclusive_lock) = @_;
  142.     open F_lock, $authorisation_file; # don't care if it's missing
  143.     flock(F_lock, $exclusive_lock ? 2 : 1) or die "can't lock";
  144.     my %conf;
  145.     foreach (<F_lock>) {
  146.     s/#.*//; # remove comments
  147.     s/^\s+//; 
  148.     s/\s+$//;
  149.     /^$/ and next;
  150.     my ($cmd, $value) = split('=', $_, 2);
  151.     $conf{$cmd} = $value || warn qq(suspicious line "$_" in $authorisation_file\n);
  152.     }
  153.     # no close F_lock, keep it locked
  154.     \%conf
  155. }
  156.  
  157. sub check {
  158.     my ($exclusive_lock) = @_;
  159.     my $conf = read_conf($exclusive_lock);
  160.     if (lc($conf->{FILESHARING}) eq 'no') {
  161.       ::error($not_enabled);
  162.     }
  163.     
  164.     if (lc($conf->{SHARINGMODE}) eq 'advanced') {
  165.       ::error($not_simple_enabled);
  166.     }
  167.     
  168.     if (lc($conf->{FILESHAREGROUP} ne '')) {
  169.       $authorisation_group = lc($conf->{FILESHAREGROUP});
  170.     }      
  171.     
  172.     if (lc($conf->{RESTRICT}) eq 'no') {
  173.     # ok, access granted for everybody
  174.     } else {
  175.     my @l;
  176.     while (@l = getgrent) {
  177.         last if $l[0] eq $authorisation_group;
  178.     }
  179.     ::member($username, split(' ', $l[3])) or ::error($non_authorised);
  180.     }
  181. }
  182.  
  183. ################################################################################
  184. package exports;
  185.  
  186. sub find {
  187.     my ($exports, $mntpoint) = @_;
  188.     foreach (@$exports) {
  189.     $_->{mntpoint} eq $mntpoint and return $_;
  190.     }
  191.     undef;
  192. }
  193.  
  194. sub add {
  195.     my ($exports, $mntpoint) = @_;
  196.     foreach (@$exports) {
  197.     $_->{mntpoint} eq $mntpoint and die 'add';
  198.     }
  199.     push @$exports, my $e = { mntpoint => $mntpoint };
  200.     $e;
  201. }
  202.  
  203. sub remove {
  204.     my ($exports, $mntpoint) = @_;
  205.     my @l = grep { $_->{mntpoint} ne $mntpoint } @$exports;
  206.     @l < @$exports or die 'remove';
  207.     @$exports = @l;  
  208. }
  209.  
  210.  
  211. ################################################################################
  212. package nfs_exports;
  213.  
  214. use vars qw(@ISA $conf_file $default_options);
  215. BEGIN { @ISA = 'exports' }
  216.  
  217. sub read {
  218.     my $file = $conf_file;
  219.     local *F;
  220.     open F, $file or return [];
  221.  
  222.     my ($prev_raw, $prev_line, %e, @l);
  223.     my $line_nb = 0;
  224.     foreach my $raw (<F>) {
  225.     $line_nb++;
  226.     local $_ = $raw;
  227.     $raw .= "\n" if !/\n/;
  228.  
  229.     s/#.*//; # remove comments
  230.  
  231.     s/^\s+//; 
  232.     s/\s+$//; # remove unuseful spaces to help regexps
  233.  
  234.     if (/^$/) {
  235.         # blank lines ignored
  236.         $prev_raw .= $raw;
  237.         next;
  238.     }
  239.  
  240.     if (/\\$/) {
  241.         # line continue across lines
  242.         chop; # remove the backslash
  243.         $prev_line .= "$_ ";
  244.         $prev_raw .= $raw;
  245.         next;
  246.     }
  247.     my $line = $prev_line . $_;
  248.     my $raw_line = $prev_raw . $raw;
  249.     ($prev_line, $prev_raw) = ('', '');
  250.  
  251.     my ($mntpoint, $options) = $line =~ /("[^"]*"|\S+)\s+(.*)/ or die "$file:$line_nb: bad line $line\n";
  252.  
  253.     # You can also specify spaces or any other unusual characters in the
  254.     # export path name using a backslash followed by the character code as
  255.     # 3 octal digits.
  256.     $mntpoint =~ s/\\(\d{3})/chr(oct $1)/ge;
  257.  
  258.     # not accepting weird characters that would break the output
  259.     $mntpoint =~ m/[\0\n\r]/ and die "i won't handle this";
  260.     push @l, { mntpoint => $mntpoint, option => $options, raw => $raw_line };
  261.     }
  262.     bless \@l, 'nfs_exports';
  263. }
  264.  
  265. sub write {
  266.     my ($nfs_exports) = @_;
  267.     foreach (@$nfs_exports) {
  268.     if (!exists $_->{options}) {
  269.         $_->{options} = $default_options;
  270.     }
  271.     if (!exists $_->{raw}) {        
  272.         my $mntpoint = $_->{mntpoint} =~ /\s/ ? qq("$_->{mntpoint}") : $_->{mntpoint};
  273.         $_->{raw} = sprintf("%s %s\n", $mntpoint, $_->{options});
  274.     }
  275.     }
  276.     local *F;
  277.     open F, ">$conf_file" or die "can't write $conf_file";
  278.     print F $_->{raw} foreach @$nfs_exports;
  279. }
  280.  
  281. sub update_server {
  282.     if (fork) {
  283.     system('/usr/sbin/exportfs', '-r');
  284.     if (system('PATH=/bin:/sbin pidof rpc.mountd >/dev/null') != 0 ||
  285.         system('PATH=/bin:/sbin pidof nfsd >/dev/null') != 0) {
  286.         # trying to start the server...
  287.         system('/etc/init.d/portmap start') if system('/etc/init.d/portmap status') != 0;
  288.             if ( -f '/etc/init.d/nfs' ) {
  289.             system('/etc/init.d/nfs', $_) foreach 'stop', 'start';
  290.             }
  291.             elsif ( -f '/etc/init.d/nfs-kernel-server' ) {
  292.             system('/etc/init.d/nfs-kernel-server', $_) foreach 'stop', 'start';
  293.             }
  294.     }
  295.     exit 0;
  296.     }
  297. }
  298.  
  299. ################################################################################
  300. package smb_exports;
  301.  
  302. use vars qw(@ISA $conf_file);
  303. BEGIN { @ISA = 'exports' }
  304.  
  305. sub read {
  306.     my ($s, @l);
  307.     local *F;
  308.     open F, $conf_file;
  309.     local $_;
  310.     while (<F>) {
  311.     if (/^\s*\[.*\]/ || eof F) {
  312.         #- first line in the category
  313.         my ($label) = $s =~ /^\s*\[(.*)\]/;
  314.         my ($mntpoint) = $s =~ /^\s*path\s*=\s*(.*)/m;
  315.         push @l, { mntpoint => $mntpoint, raw => $s, label => $label };
  316.         $s = '';
  317.     }
  318.     $s .= $_;
  319.     }
  320.     bless \@l, 'smb_exports';
  321. }
  322.  
  323. sub write {
  324.     my ($smb_exports) = @_;
  325.     foreach (@$smb_exports) {
  326.     if (!exists $_->{raw}) {
  327.         $_->{raw} = <<EOF;
  328.  
  329. [$_->{label}]
  330.    path = $_->{mntpoint}
  331.    comment = $_->{mntpoint}
  332.    public = yes
  333.    guest ok = yes
  334.    writable = no
  335.    wide links = no
  336. EOF
  337.     }
  338.     }
  339.     local *F;
  340.     open F, ">$conf_file" or die "can't write $conf_file";
  341.     print F $_->{raw} foreach @$smb_exports;
  342. }
  343.  
  344. sub add {
  345.     my ($exports, $mntpoint) = @_;
  346.     my $e = $exports->exports::add($mntpoint);
  347.     $e->{label} = name_mangle($mntpoint, map { $_->{label} } @$exports);
  348. }
  349.  
  350. sub name_mangle {
  351.     my ($input, @others) = @_;
  352.  
  353.     local $_ = $input;
  354.  
  355.     # 1. first only keep legal characters. "/" is also kept for the moment
  356.     tr|a-z|A-Z|;
  357.     s|[^A-Z0-9#\-_!/]|_|g; # "$" is allowed except at the end, remove it in any case
  358.     
  359.     # 2. removing non-interesting parts
  360.     s|^/||;
  361.     s|^home/||;
  362.     s|_*/_*|/|g;
  363.     s|_+|_|g;
  364.  
  365.     # 3. if size is too small (!), make it bigger
  366.     $_ .= "_" while length($_) < 3;
  367.  
  368.     # 4. if size is too big, shorten it
  369.     while (length > 12) {
  370.     my ($s) = m|.*?/(.*)|;
  371.     if (length($s) > 8 && !grep { /\Q$s/ } @others) {
  372.         # dropping leading directories when the resulting is still long and meaningful
  373.         $_ = $s;
  374.         next;
  375.     }
  376.     s|(.*)[0-9#\-_!/]|$1| and next;
  377.  
  378.     # inspired by "Christian Brolin" "Long names are doom" on comp.lang.functional
  379.     s|(.+)[AEIOU]|$1| and next; # allButFirstVowels
  380.     s|(.*)(.)\2|$1$2| and next; # adjacentDuplicates
  381.  
  382.     s|(.*).|$1|; # booh, :'-(
  383.     }
  384.  
  385.     # 5. remove "/"s still there
  386.     s|/|_|g;
  387.  
  388.     # 6. resolving conflicts
  389.     my $l = join("|", map { quotemeta } @others);
  390.     my $conflicts = qr|^($l)$|;
  391.     if (/$conflicts/) {
  392.       A: while (1) {
  393.         for (my $nb = 1; length("$_$nb") <= 12; $nb++) {
  394.         if ("$_$nb" !~ /$conflicts/) {
  395.             $_ = "$_$nb";
  396.             last A;
  397.         }
  398.         }
  399.         $_ or die "can't find a unique name";
  400.         # can't find a unique name, dropping the last letter
  401.         s|(.*).|$1|;
  402.     }
  403.     }
  404.  
  405.     # 7. done
  406.     $_;
  407. }
  408.  
  409. sub update_server {
  410.   if (fork) {
  411.     system('/usr/bin/killall -HUP smbd 2>/dev/null');
  412.     if (system('PATH=/bin:/sbin pidof smbd >/dev/null') != 0 ||
  413.     system('PATH=/bin:/sbin pidof nmbd >/dev/null') != 0) {
  414. # trying to start the server...
  415.       if ( -f '/etc/init.d/smb' ) {
  416.     system('/etc/init.d/smb', $_) foreach 'stop', 'start';
  417.       }
  418.       elsif ( -f '/etc/init.d/samba' ) {
  419.     system('/etc/init.d/samba', $_) foreach 'stop', 'start';
  420.       }
  421.       elsif ( -f '/etc/rc.d/rc.samba' ) {
  422.     system('/etc/rc.d/rc.samba', $_) foreach 'stop', 'start';
  423.       }
  424.       else {
  425.     print STDERR "Error: Can't find the samba init script \n";
  426.       }
  427.     }
  428.     exit 0;
  429.   }
  430. }
  431.